home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / jdbtree.com / CUST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-07  |  3.4 KB  |  144 lines
  1. {=======================================================================
  2.             File:  CUSTOMER.PAS
  3.           Author:  Jeffrey L. Darling
  4. Date established:  06-07-1991
  5.   Latest release:  06-07-1991
  6.  Current Version:  1.00
  7. =======================================================================}
  8. Program Customer;
  9.  
  10. Uses Crt;
  11.  
  12. type String_10 = String[10];
  13.      Branch=^Treenode;
  14.      Treenode = record
  15.        Account_num : Integer;
  16.        Index : integer;
  17.        Left,Right : Branch
  18.      end; {TreeNode}
  19.      Customer_rec = record
  20.        Name : String[10];
  21.        Account_num : Integer;
  22.      end; {Customer_rec}
  23.  
  24.  
  25.  
  26. Var Root : Branch;
  27.     Cust_File : File of Customer_rec;
  28.     Cust_rec :Customer_rec;
  29.     Rec_num : Integer;
  30.     flag : char;  {End of file flag}
  31.  
  32.  
  33. procedure makefile;
  34.  
  35.   Begin {Makefile}
  36.   {Erase file if already present}
  37.   assign(Cust_File, 'CUST.DAT');
  38.   {$I-}
  39.   Reset(Cust_File);
  40.   {$I+}
  41.   If IOResult = 0 Then
  42.    begin
  43.     close(Cust_File);
  44.     Erase(Cust_File);
  45.    end;
  46.   assign(Cust_File, 'CUST.DAT');
  47.   rewrite(Cust_File);
  48.   While Upcase(flag) <> 'N' do
  49.   begin
  50.     With Cust_rec do
  51.     begin
  52.        Write('Enter name: ');
  53.        Readln(name);
  54.        Write('Enter Account number: ');
  55.        Readln(Account_num);
  56.        Write('More records? ');
  57.        Readln(Flag);
  58.     end;
  59.     Write(Cust_file, Cust_rec);
  60.   end;
  61.   close(Cust_file);
  62.   end; {Makefile}
  63.  
  64.  
  65. Procedure BuildTree(var Root : Branch);
  66.  
  67. var Ancestor : Branch;
  68.  
  69. Procedure AttachNode(Cust_Rec : Customer_rec;
  70.                      Var Ancestor : Branch);
  71. begin {AttachNode}
  72.   New(Ancestor);
  73.      begin
  74.         Ancestor^.Account_num := Cust_Rec.Account_num;
  75.         Ancestor^.Index := Rec_num;
  76.         Ancestor^.Left := nil; Ancestor^.Right := nil
  77.      end
  78. end; {AttachNode}
  79.  
  80. Procedure PutInTree (Cust_rec : Customer_Rec;
  81.  
  82.                      var Ancestor : Branch);
  83.  
  84. begin {PutInTree}
  85.    if Ancestor = nil then
  86.       AttachNode(Cust_rec, Ancestor)
  87.    else if Cust_Rec.Account_num = Ancestor^.Account_num then
  88.         writeln('Error, duplicate account number in file')
  89.    else if Cust_Rec.Account_num < Ancestor^.Account_num then
  90.         PutInTree(Cust_Rec, Ancestor^.Left)
  91.    else PutInTree(Cust_Rec, Ancestor^.Right)
  92. end; {PutInTree}
  93.  
  94. begin {BuildTree}
  95.   assign(Cust_File, 'CUST.DAT');
  96.   reset(Cust_File);
  97.   Read(Cust_File, Cust_rec);
  98.   Rec_num := Rec_num + 1;
  99.   AttachNode(Cust_Rec, Root);
  100.   while not EOF(Cust_File) do
  101.     begin
  102.       Read(Cust_File, Cust_Rec);
  103.       Rec_num := Rec_num + 1;
  104.       Ancestor := Root;
  105.       PutInTree(Cust_Rec, Ancestor);
  106.     end;
  107. end;  {BuildTree}
  108.  
  109. Procedure Traverse(Root : Branch);
  110.  
  111. begin {Traverse}
  112.   if Root <> nil then
  113.      begin
  114.        Traverse(Root^.Left);
  115.        Write('  ',Root^.Index + 1,'         ');
  116.        Write(Root^.Account_num,'           ');
  117.        Seek(Cust_File,Root^.Index);
  118.        Read(Cust_file,Cust_rec);
  119.        Writeln(Cust_rec.Name);
  120.        Traverse(Root^.Right);
  121.      end;
  122. end; {Traverse}
  123.  
  124.  
  125. begin {MAIN}
  126. clrscr;
  127. Flag := 'Y';
  128. {makefile;}  {Use this procedure only to Change the data file}
  129. flag := 'Y';
  130. While Upcase(Flag) <> 'N' do
  131. begin
  132. Rec_num := -1;
  133. ClrScr;
  134. BuildTree(Root);
  135. Writeln('Index   Account Number     Name');
  136. Writeln('~~~~~   ~~~~~~~~~~~~~~     ~~~~');
  137. Traverse(root);
  138. close(Cust_file);
  139. Writeln;
  140. Write('Run this program again? (y/n) ');readln(flag);
  141. end;
  142. end. {MAIN}
  143.  
  144.